home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff2.arc / MEMSCREN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-12-02  |  2.2 KB  |  88 lines
  1.  
  2. program ScreenMap;
  3.  
  4.   {  program to Write to the screen map  }
  5.  
  6. const
  7.   ColorSeg   = $B000;
  8.   ColorOfs   = $8000;
  9.   BWSeg      = $B000;
  10.   BWOfs      = $0000;
  11.  
  12. var
  13.   I,J        : Integer;
  14.   C          : Char;
  15.   RowNumber,ColNumber,Length,Dir
  16.              : Integer;
  17.   Direction  : Char;
  18.  
  19. procedure X(J,K : Integer);
  20. begin
  21.   Mem[ColorSeg:ColorOfs + J] := K    { Write to screen memory }
  22. end; { of proc X }
  23.  
  24. procedure Y(R,C,N,Ch,D : Integer);    {r=row C=column n=length ch=char}
  25. var
  26.   I,J : Integer;
  27. begin
  28.   J :=((R-1)*160) + ((C-1)*2);      { compute starting location }
  29.   for I := 1 to N do begin
  30.     X(J,Ch);                        { loop n times }
  31.     if D=0
  32.       then J := J + 160
  33.       else J:= J+2;
  34.   end
  35. end; { of proc Y }
  36.  
  37. begin
  38.   ClrScr;
  39.   GotoXY(20,10);
  40.   Write('Do you want to play <Y/N> ? ');
  41.   Read(kbd,C);
  42.   if (C = 'y') or (C = 'Y') then begin
  43.     repeat
  44.       ClrScr;
  45.       GotoXY(20,10);
  46.       Write('Would you like to draw a line <Y/N> ? ');
  47.       Read(kbd,C);
  48.     until (C = 'y') or (C = 'Y') or (C = 'n') or (C = 'N');
  49.     if (C = 'y') or (C = 'Y') then begin
  50.       repeat
  51.         ClrScr;
  52.         Y(1,1,80,31,1);
  53.         Y(2,1,24,16,0);
  54.         Y(2,80,24,17,0);
  55.         Y(25,2,78,30,1);
  56.         GotoXY(20,10);
  57.         Write('The line start at what row? ');
  58.         Read(rownumber);
  59.         GotoXY(20,12);
  60.         Write('               what column? ');
  61.         Read(colnumber);
  62.         GotoXY(20,14);
  63.         Write('     Line length in number? ');
  64.         Read(length);
  65.         GotoXY(20,16);
  66.         Write('     What charactor to use? ');
  67.         Read(Kbd,C); Write(C);
  68.         repeat
  69.           GotoXY(10,18); Write(' which direction <d>own or <a>cross ? ');
  70.           Read(Direction)
  71.         until (Direction='a') or (Direction='d');
  72.         if Direction='a'
  73.           then Dir:=1
  74.           else Dir:=0;
  75.         ClrScr;
  76.         Y(rownumber,colnumber,length,ord(C),dir);
  77.         GotoXY(40,24);
  78.         Write('Your line. Try again? ');
  79.         Read(Trm,C);
  80.        until (C <> 'Y') and (C <> 'y');
  81.        ClrScr
  82.     end
  83.   end
  84.   else begin
  85.     GotoXY(23,13);
  86.     WriteLn('******** Bye ********')
  87.   end
  88. end. { of program ScreenMap }